home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 2 / Gold Medal Software Volume 2 (Gold Medal) (1994).iso / database / mltlku.arj / SET_CODE.CLA < prev   
Text File  |  1993-06-08  |  2KB  |  52 lines
  1.       member()
  2. !------------------------------
  3. set_code  procedure(field_name)
  4. field_name string(16)
  5.  
  6. ERR_SCR         SCREEN      WINDOW(7,65),AT(14,9),HUE(15,4)
  7.  OMIT('**-END-**')
  8.     ┌───────────────────────────────────────────────────────────────
  9.     │                * ERROR *                ║
  10.     │  Procedure SET_CODE encountered invalid field  FE FE FE FE FE FE FE FE FE FE FE FE FE FE    ║
  11.     │            Lookup Will Fail!            ║
  12.     │                                ║
  13.     │                        Press ENTER    ║
  14.      ═══════════════════════════════════════════════════════════════╝
  15. **-END-**
  16.  
  17.            ROW(1,1)      STRING('┌─{63}'),HUE(15,4)
  18.            ROW(2,1)      REPEAT(5);STRING('│'),HUE(15,4) .
  19.          COL(65)  REPEAT(5);STRING('║'),HUE(0,4) .
  20.            ROW(7,2)      STRING('═{63}╝'),HUE(0,4)
  21.            ROW(2,29)  STRING('*'),HUE(28,4)
  22.          COL(31)  STRING('ERROR *'),HUE(28,4)
  23.            ROW(3,4)      STRING('Procedure SET_CODE encountered invalid field'|
  24.                 & ' '),HUE(7,4)
  25.            ROW(4,25)  STRING('Lookup Will Fail!'),HUE(7,4)
  26.            ROW(6,49)  STRING('Press ENTER'),HUE(16,4)
  27. FIELD_OUT      ROW(3,49)  STRING(14),HUE(7,4)
  28.          .
  29. p       byte
  30.  
  31.   code
  32.     p = instring(':',field_name)          !DOES FIELD NAME HAVE PREFIX?
  33.     if p > 0 then
  34.       field_name = sub(field_name, p+1, 16)   !REMOVE THE "AAA:" PREFIX
  35.     .
  36.     case upper(field_name)
  37.       of 'STATE_ID'
  38.         cod:code_type = 'ST'
  39.       of 'BLD_ID'
  40.         cod:code_type = 'BLD'
  41.       of 'COUNTRY_ID'
  42.         cod:code_type = 'COU'
  43.       of 'GENDER'
  44.         cod:code_type = 'GEN'
  45.     else
  46.       open(err_scr)
  47.       field_out = '"'&clip(field_name)&'"'
  48.       ask
  49.       close(err_scr)
  50.     .
  51.     return
  52.